home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog6.arj / ACCPOPUP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  2.6 KB  |  106 lines
  1. { accpopup.pas -- Add accelerators to floating popup menus }
  2.  
  3. program AccPopup;
  4.  
  5. {$R accpopup.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID }
  12.   id_Accs  = 200;    { Accelerator resource ID }
  13.   cm_CtrlT = 101;    { Command ID for Ctrl+T }
  14.   cm_CtrlP = 102;    { Command ID for Ctrl+P }
  15.   cm_CtrlW = 103;    { Command ID for Ctrl+W }
  16.   cm_Quit  = 104;    { Command ID for Alt+X  }
  17.  
  18. type
  19.  
  20.   AccPopupApplication = object(TApplication)
  21.     procedure InitInstance; virtual;
  22.     procedure InitMainWindow; virtual;
  23.   end;
  24.  
  25.   PAccPopupWindow = ^AccPopupWindow;
  26.   AccPopupWindow = object(TWindow)
  27.     procedure Message(P: PChar);
  28.     procedure WMCommand(var Msg: TMessage);
  29.       virtual wm_First + wm_Command;
  30.     procedure WMRButtonDown(var Msg: TMessage);
  31.       virtual wm_First + wm_RButtonDown;
  32.   end;
  33.  
  34.  
  35. { AccPopupApplication }
  36.  
  37. {- Initialize this instance of the application }
  38. procedure AccPopupApplication.InitInstance;
  39. begin
  40.   TApplication.InitInstance;
  41.   HAccTable := LoadAccelerators(HInstance, PChar(id_Accs))
  42. end;
  43.  
  44. {- Initialize AccPopupApplication object's window }
  45. procedure AccPopupApplication.InitMainWindow;
  46. begin
  47.   MainWindow := New(PAccPopupWindow,
  48.     Init(nil, 'Click right mouse button for menu'))
  49. end;
  50.  
  51.  
  52. { AccPopupWindow }
  53.  
  54. {- Display a message in a message-box window }
  55. procedure AccPopupWindow.Message(P: PChar);
  56. begin
  57.   MessageBox(HWindow, P, 'You selected...', mb_Ok)
  58. end;
  59.  
  60. {- Intercept all wm_SysCommand messages }
  61. procedure AccPopupWindow.WMCommand(var Msg: TMessage);
  62. begin
  63.   case Msg.WParam of
  64.     cm_CtrlT: Message('First Command -- Ctrl+T');
  65.     cm_CtrlP: Message('Second Command -- Ctrl+P');
  66.     cm_CtrlW: Message('Third Command -- Ctrl+W');
  67.     cm_Quit: CloseWindow;
  68.   else
  69.     TWindow.WMCommand(Msg)
  70.   end
  71. end;
  72.  
  73. {- Create, display, use, and destroy the floating popup menu }
  74. procedure AccPopupWindow.WMRButtonDown(var Msg: TMessage);
  75. var
  76.   P: TPoint;
  77.   MenuH, PopupMenuH: HMenu;
  78. begin
  79.   P.X := Msg.LParamLo;
  80.   P.Y := Msg.LParamHi;
  81.   ClientToScreen(HWindow, P);
  82.   MenuH := LoadMenu(HInstance, PChar(id_Menu));
  83.   if MenuH <> 0 then
  84.   begin
  85.     PopupMenuH := GetSubMenu(MenuH, 0);
  86.     TrackPopupMenu(PopupMenuH, 0, P.X, P.Y, 0, HWindow, nil);
  87.     DestroyMenu(MenuH)
  88.   end
  89. end;
  90.  
  91. var
  92.  
  93.   AccPopupApp: AccPopupApplication;
  94.  
  95. begin
  96.   AccPopupApp.Init('AccPopupApp');
  97.   AccPopupApp.Run;
  98.   AccPopupApp.Done
  99. end.
  100.  
  101.  
  102. {--------------------------------------------------------------
  103.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  104.   Revision 1.00    Date: 2/22/1991
  105. ---------------------------------------------------------------}
  106.